home *** CD-ROM | disk | FTP | other *** search
/ PCGUIA 127 / PC Guia 127.iso / Software / Utils / GParted Live CD / Bin / gparted-livecd-0.2.2.iso / usr_sqfs / bin / multixterm < prev    next >
Encoding:
Text File  |  2005-07-18  |  29.7 KB  |  991 lines
  1. #!/bin/sh
  2. # \
  3. exec expectk "$0" ${1+"$@"}
  4. #
  5. # NAME
  6. #    multixterm - drive multiple xterms separately or together
  7. #
  8. # SYNOPSIS
  9. #    multixterm [-xa "xterm args"]
  10. #           [-xc "command"]
  11. #           [-xd "directory"]
  12. #           [-xf "file"]
  13. #           [-xn "xterm names"]
  14. #           [-xv] (enable verbose mode)
  15. #           [-xh] or [-x?] (help)
  16. #           [xterm names or user-defined args...]
  17. #
  18. # DESCRIPTION
  19. #    Multixterm creates multiple xterms that can be driven together
  20. #    or separately.
  21. #
  22. #    In its simplest form, multixterm is run with no arguments and
  23. #    commands are interactively entered in the first entry field.
  24. #    Press return (or click the "new xterm" button) to create a new
  25. #    xterm running that command.
  26. #
  27. #    Keystrokes in the "stdin window" are redirected to all xterms
  28. #    started by multixterm.  xterms may be driven separately simply
  29. #    by focusing on them.
  30. #
  31. #    The stdin window must have the focus for keystrokes to be sent
  32. #    to the xterms.  When it has the focus, the color changes to
  33. #    aquamarine.  As characters are entered, the color changes to
  34. #    green for a second.  This provides feedback since characters
  35. #    are not echoed in the stdin window.
  36. #
  37. #    Typing in the stdin window while holding down the alt or meta
  38. #    keys sends an escape character before the typed characters.
  39. #    This provides support for programs such as emacs.
  40. #
  41. # ARGUMENTS
  42. #    The optional -xa argument indicates arguments to pass to
  43. #    xterm.
  44. #
  45. #    The optional -xc argument indicates a command to be run in
  46. #    each named xterm (see -xn).  With no -xc argument, the command
  47. #    is the current shell.
  48. #
  49. #    The optional -xd argument indicates a directory to search for
  50. #    files that will appear in the Files menu.  By default, the
  51. #    directory is: ~/lib/multixterm
  52. #
  53. #    The optional -xf argument indicates a file to be read at
  54. #    startup.  See FILES below for more info.
  55. #
  56. #    The optional -xn argument indicates a name for each xterm.
  57. #    This name will also be substituted for any %n in the command
  58. #    argument (see -xc).
  59. #
  60. #    The optional -xv flag puts multixterm into a verbose mode
  61. #    where it will describe some of the things it is doing
  62. #    internally.  The verbose output is not intended to be
  63. #    understandable to anyone but the author.
  64. #
  65. #    Less common options may be changed by the startup file (see
  66. #    FILES below).
  67. #
  68. #    All the usual X and wish flags are supported (i.e., -display,
  69. #    -name).  There are so many of them that to avoid colliding and
  70. #    make them easy to remember, all the multixterm flags begin
  71. #    with -x.
  72. #
  73. #    If any arguments do not match the flags above, the remainder
  74. #    of the command line is made available for user processing.  By
  75. #    default, the remainder is used as a list of xterm names in the
  76. #    style of -xn. The default behavior may be changed using the
  77. #    .multixtermrc file (see DOT FILE below).
  78. #
  79. # EXAMPLE COMMAND LINE ARGUMENTS
  80. #    The following command line starts up two xterms using ssh to
  81. #    the hosts bud and dexter.
  82. #
  83. #        multixterm -xc "ssh %n" bud dexter
  84. #
  85. # FILES
  86. #    Command files may be used to drive or initialize multixterm.
  87. #    The File menu may be used to invoke other files.  If files
  88. #    exist in the command file directory (see -xd above), they will
  89. #    appear in the File menu.  Files may also be loaded by using
  90. #    File->Open.  Any filename is acceptable but the File->Open
  91. #    browser defaults to files with a .mxt suffix.
  92. #
  93. #    Files are written in Tcl and may change any variables or
  94. #    invoke any procedures.  The primary variables of interest are
  95. #    'xtermCmd' which identifies the command (see -xc) and
  96. #    'xtermNames' which is a list of names (see -xn).  The
  97. #    procedure xtermStartAll, starts xterms for each name in the
  98. #    list.  Other variables and procedures may be discovered by
  99. #    examining multixterm itself.
  100. #
  101. # EXAMPLE FILE
  102. #    The following file does the same thing as the earlier example
  103. #    command line:
  104. #
  105. #        # start two xterms connected to bud and dexter
  106. #        set xtermCmd "ssh %n"
  107. #        set xtermNames {bud dexter}
  108. #        xtermStartAll
  109. #
  110. # DOT FILE
  111. #    At startup, multixterm reads ~/.multixtermrc if present.  This
  112. #    is similar to the command files (see FILES above) except that
  113. #    .multixtermrc may not call xtermStartAll.  Instead it is
  114. #    called implicitly, similar to the way that it is implicit in
  115. #    the command line use of -xn.
  116. #
  117. #    The following example .multixtermrc file makes every xterm run
  118. #    ssh to the hosts named on the command line.
  119. #
  120. #        set xtermCmd "ssh %n"
  121. #
  122. #    Then multixterm could be called simply:
  123. #
  124. #        multixterm bud dexter
  125. #
  126. #    If any command-line argument does not match a multixterm flag,
  127. #    the remainder of the command line is made available to
  128. #    .multixtermrc in the argv variable.  If argv is non-empty when
  129. #    .multixtermrc returns, it is assigned to xtermNames unless
  130. #    xtermNames is non-empty in which case, the content of argv is
  131. #    ignored.
  132. #
  133. #    Commands from .multixtermrc are evaluated early in the
  134. #    initialization of multixterm.  Anything that must be done late
  135. #    in the initialization (such as adding additional bindings to
  136. #    the user interface) may be done by putting the commands inside
  137. #    a procedure called "initLate".
  138. #
  139. # MENUS
  140. #    Except as otherwise noted, the menus are self-explanatory.
  141. #    Some of the menus have dashed lines as the first entry.
  142. #    Clicking on the dashed lines will "tear off" the menus.
  143. #
  144. # USAGE SUGGESTION - ALIASES AND COMMAND FILES
  145. #    Aliases may be used to store lengthy command-line invocations.
  146. #    Command files can be also be used to store such invocations
  147. #    as well as providing a convenient way to share configurations.
  148. #
  149. #    Tcl is a general-purpose language.  Thus multixterm command
  150. #    files can be extremely flexible, such as loading hostnames
  151. #    from other programs or files that may change from day-to-day.
  152. #    In addition, command files can be used for other purposes.
  153. #    For example, command files may be used to prepared common
  154. #    canned interaction sequences.  For example, the command to
  155. #    send the same string to all xterms is:
  156. #
  157. #        xtermSend "a particularly long string"
  158. #
  159. #    The File menu (torn-off) makes canned sequences particularly
  160. #    convenient.  Interactions could also be bound to a mouse
  161. #    button, keystroke, or added to a menu via the .multixtermrc
  162. #    file.
  163. #
  164. # USAGE SUGGESTION - HANDLING MANY XTERMS BY TILING
  165. #    The following .multixtermrc causes tiny xterms to tile across
  166. #    and down the screen.  (You may have to adjust the parameters
  167. #    for your screen.)  This can be very helpful when dealing with
  168. #    large numbers of xterms.
  169. #
  170. #        set yPos 0
  171. #        set xPos 0
  172. #
  173. #        trace variable xtermArgs r traceArgs
  174. #
  175. #        proc traceArgs {args} {
  176. #            global xPos yPos
  177. #            set ::xtermArgs "-geometry 80x12+$xPos+$yPos -font 6x10"
  178. #            if {$xPos} {
  179. #            set xPos 0
  180. #            incr yPos 145
  181. #            if {$yPos > 800} {set yPos 0}
  182. #            } else {
  183. #            set xPos 500
  184. #            }
  185. #        }
  186. #
  187. #    The xtermArgs variable in the code above is the variable
  188. #    corresponding to the -xa argument.
  189. #
  190. #    xterms can be also be created directly.  The following command
  191. #    file creates three xterms overlapped horizontally:
  192. #
  193. #        set xPos 0
  194. #
  195. #        foreach name {bud dexter hotdog} {
  196. #            set ::xtermArgs "-geometry 80x12+$xPos+0 -font 6x10"
  197. #            set ::xtermNames $name
  198. #            xtermStartAll
  199. #            incr xPos 300
  200. #        }
  201. #
  202. # USAGE SUGGESTION - SELECTING HOSTS BY NICKNAME
  203. #    The following .multixtermrc shows an example of changing the
  204. #    default handling of the arguments from hostnames to a filename
  205. #    containing hostnames:
  206. #
  207. #        set xtermNames [exec cat $argv]
  208. #
  209. #    The following is a variation, retrieving the host names from
  210. #    the yp database:
  211. #
  212. #        set xtermNames [exec ypcat $argv]
  213. #
  214. #    The following hardcodes two sets of hosts, so that you can
  215. #    call multixterm with either "cluster1" or "cluster2":
  216. #
  217. #        switch $argv {
  218. #            cluster1 {
  219. #            set xtermNames "bud dexter"
  220. #            }
  221. #            cluster2 {
  222. #            set xtermNames "frank hotdog weiner"
  223. #            }
  224. #        }
  225. #
  226. # COMPARE/CONTRAST
  227. #    It is worth comparing multixterm to xkibitz.  Multixterm
  228. #    connects a separate process to each xterm.  xkibitz connects
  229. #    the same process to each xterm.
  230. #
  231. # LIMITATIONS
  232. #    Multixterm provides no way to remotely control scrollbars,
  233. #    resize, and most other window system related functions.
  234. #
  235. #    Multixterm can only control new xterms that multixterm itself
  236. #    has started.
  237. #
  238. #    As a convenience, the File menu shows a limited number of
  239. #    files.  To show all the files, use File->Open.
  240. #
  241. # FILES
  242. #    $DOTDIR/.multixtermrc   initial command file
  243. #    ~/.multixtermrc         fallback command file
  244. #    ~/lib/multixterm/       default command file directory
  245. #
  246. # BUGS
  247. #    If multixterm is killed using an uncatchable kill, the xterms
  248. #    are not killed.  This appears to be a bug in xterm itself.
  249. #
  250. #    Send/expect sequences can be done in multixterm command files.
  251. #    However, due to the richness of the possibilities, to document
  252. #    it properly would take more time than the author has at present.
  253. #
  254. # REQUIREMENTS
  255. #    Requires Expect 5.36.0 or later.
  256. #    Requires Tk 8.3.3 or later.
  257. #
  258. # VERSION
  259. #!    $::versionString
  260. #    The latest version of multixterm is available from
  261. #    http://expect.nist.gov/example/multixterm .  If your version of Expect
  262. #    and Tk are too old (see REQUIREMENTS above), download a new version of
  263. #    Expect from http://expect.nist.gov
  264. #
  265. # DATE
  266. #!    $::versionDate
  267. #
  268. # AUTHOR
  269. #    Don Libes <don@libes.com>
  270. #
  271. # LICENSE
  272. #    Multixterm is in the public domain; however the author would
  273. #    appreciate acknowledgement if multixterm or parts of it or ideas from
  274. #    it are used.
  275.  
  276. ######################################################################
  277. # user-settable things - override them in the ~/.multixtermrc file
  278. #             or via command-line options
  279. ######################################################################
  280.  
  281. set palette       #d8d8ff   ;# lavender
  282. set colorTyping   green
  283. set colorFocusIn  aquamarine
  284.  
  285. set xtermNames    {}
  286. set xtermCmd      $env(SHELL)
  287. set xtermArgs     ""
  288. set cmdDir      ~/lib/multixterm
  289. set inputLabel    "stdin window"
  290.  
  291. set fileMenuMax   30     ;# max number of files shown in File menu
  292. set tearoffMenuMin 2     ;# min number of files needed to enable the File
  293.              ;# menu to be torn off
  294.  
  295. proc initLate {} {}      ;# anything that must be done late in initialization
  296.              ;# such as adding/modifying bindings, may be done by
  297.              ;# redefining this
  298.  
  299. ######################################################################
  300. # end of user-settable things
  301. ######################################################################
  302.  
  303. ######################################################################
  304. # sanity checking
  305. ######################################################################
  306.  
  307. set versionString 1.8
  308. set versionDate "2004/06/29"
  309.  
  310. package require Tcl
  311. catch {package require Tk} ;# early versions of Tk had no package
  312. package require Expect
  313.  
  314. proc exit1 {msg} {
  315.     puts "multixterm: $msg"
  316.     exit 1
  317. }
  318.  
  319. exp_version -exit 5.36
  320.  
  321. proc tkBad {} {
  322.     exit1 "requires Tk 8.3.3 or later but you are using    Tk $::tk_patchLevel."
  323. }
  324.  
  325. if {$tk_version < 8.3} {
  326.     tkBad
  327. } elseif {$tk_version == 8.3} {
  328.     if {[lindex [split $tk_patchLevel .] 2] < 3} tkBad
  329. }
  330.  
  331. ######################################################################
  332. # process args - has to be done first to get things like -xv working ASAP
  333. ######################################################################
  334.  
  335. # set up verbose mechanism early
  336.  
  337. set verbose 0
  338. proc verbose {msg} {
  339.     if {$::verbose} {
  340.     if {[info level] > 1} {
  341.         set proc [lindex [info level -1] 0]
  342.     } else {
  343.         set proc main
  344.     }
  345.     puts "$proc: $msg"
  346.     }
  347. }
  348.  
  349. # read a single argument from the command line
  350. proc arg_read1 {var args} {
  351.     if {0 == [llength $args]} {
  352.     set argname -$var
  353.     } else {
  354.     set argname $args
  355.     }
  356.  
  357.     upvar argv argv
  358.     upvar $var v
  359.  
  360.     verbose "$argname"
  361.     if {[llength $argv] < 2} {
  362.     exit1 "$argname requires an argument"
  363.     }
  364.  
  365.     set v [lindex $argv 1]
  366.     verbose "set $var $v"
  367.     set argv [lrange $argv 2 end]
  368. }
  369.  
  370. proc xtermUsage {{msg {}}} {
  371.     if {![string equal $msg ""]} {
  372.     puts "multixtermrc: $msg"
  373.     }
  374.     puts {usage: multixterm [flags] ... where flags are:
  375.     [-xa "xterm args"]
  376.     [-xc "command"]
  377.     [-xd "directory"]
  378.     [-xf "file"]
  379.     [-xn "xterm names"]
  380.     [-xv] (enable verbose mode)
  381.     [-xh] or [-x?] (help)
  382.     [xterm names or user-defined args...]}
  383.     exit
  384. }
  385.  
  386. while {[llength $argv]} {
  387.     set flag [lindex $argv 0]
  388.     switch -- $flag -x? - -xh {
  389.     xtermUsage
  390.     } -xc {
  391.     arg_read1 xtermCmd -xc
  392.     } -xn {
  393.     arg_read1 xtermNames -xn
  394.     } -xa {
  395.     arg_read1 xtermArgs -xa
  396.     } -xf {
  397.     arg_read1 cmdFile -xf
  398.     if {![file exists $cmdFile]} {
  399.         exit1 "can't read $cmdFile"
  400.     }
  401.     } -xd {
  402.     arg_read1 cmdDir -xd
  403.     if {![file exists $cmdDir]} {
  404.         exit1 "can't read $cmdDir"
  405.     }
  406.     } -xv {
  407.     set argv [lrange $argv 1 end]
  408.     set verbose 1
  409.     puts "main: verbose on"
  410.     } default {
  411.     verbose "remaining args: $argv"
  412.     break    ;# let user handle remaining args later
  413.     }
  414. }
  415.  
  416. ######################################################################
  417. # determine and load rc file -  has to be done now so that widgets
  418. #     can be affected
  419. ######################################################################
  420.  
  421. # if user has no $DOTDIR, fall back to home directory
  422. if {![info exists env(DOTDIR)]} {
  423.     set env(DOTDIR) ~
  424. }
  425. # catch bogus DOTDIR, otherwise glob will lose the bogus directory
  426. # and it won't appear in the error msg
  427. if {[catch {glob $env(DOTDIR)} dotdir]} {
  428.     exit1 "$env(DOTDIR)/.multixtermrc can't be found because $env(DOTDIR) doesn't exist or can't be read"
  429. } 
  430. set rcFile $dotdir/.multixtermrc
  431.  
  432. set fileTypes {
  433.     {{Multixterm Files} *.mxt}
  434.     {{All Files} *}
  435. }
  436.  
  437. proc openFile {{fn {}}} {
  438.     verbose "opening $fn"
  439.     if {[string equal $fn ""]} {
  440.     set fn [tk_getOpenFile \
  441.             -initialdir $::cmdDir \
  442.             -filetypes $::fileTypes \
  443.             -title "multixterm file"]
  444.     if {[string match $fn ""]} return
  445.     }
  446.     uplevel #0 source [list $fn]
  447.     verbose "xtermNames = \"$::xtermNames\""
  448.     verbose "xtermCmd = $::xtermCmd"
  449. }
  450.  
  451. if {[file exists $rcFile]} {
  452.     openFile $rcFile
  453. } else {
  454.     verbose "$rcFile: not found"
  455. }
  456.  
  457. if {![string equal "" $argv]} {
  458.     if {[string equal $xtermNames ""]} {
  459.     set xtermNames $argv
  460.     }
  461. }
  462.  
  463. ######################################################################
  464. # Describe and initialize some important globals
  465. ######################################################################
  466.  
  467. # ::activeList and ::activeArray both track which xterms to send
  468. # (common) keystrokes to.  Each element in activeArray is connected to
  469. # the active menu.  The list version is just a convenience making the
  470. # send function easier/faster.
  471.  
  472. set activeList {}
  473.  
  474. # ::names is an array of xterm names indexed by process spawn ids.
  475.  
  476. set names(x) ""
  477. unset names(x)
  478.  
  479. # ::xtermSid is an array of xterm spawn ids indexed by process spawn ids.
  480. # ::xtermPid is an array of xterm pids indexed by process spawn id.
  481.  
  482. ######################################################################
  483. # create an xterm and establish connections
  484. ######################################################################
  485.  
  486. proc xtermStart {cmd name} {
  487.     verbose "starting new xterm running $cmd with name $name"
  488.  
  489.     ######################################################################
  490.     # create pty for xterm
  491.     ######################################################################
  492.     set pid [spawn -noecho -pty]
  493.     verbose "spawn -pty: pid = $pid, spawn_id = $spawn_id"
  494.     set sidXterm $spawn_id
  495.     stty raw -echo < $spawn_out(slave,name)
  496.  
  497.     regexp ".*(.)(.)" $spawn_out(slave,name) dummy c1 c2
  498.     if {[string compare $c1 "/"] == 0} {
  499.     set c1 0
  500.     }
  501.  
  502.     ######################################################################
  503.     # prepare to start xterm by making sure xterm name is unique
  504.     # X doesn't care but active menu won't make sense unless names are unique
  505.     ######################################################################
  506.     set unique 1
  507.     foreach oldName [array names ::names] {
  508.     if {[string match "$name" $::names($oldName)]} {
  509.         set unique 0
  510.     }
  511.     }
  512.     verbose "uniqueness of $name: $unique"
  513.  
  514.     set safe [safe $name]
  515.  
  516.     # if not unique, look at the numerical suffixes of all matching
  517.     # names, find the biggest and increment it
  518.     if {!$unique} {
  519.     set suffix 2
  520.     foreach oldName [array names ::names] {
  521.         verbose "regexp ^[set safe](\[0-9]+)$ $::names($oldName) X num"
  522.         if {[regexp "^[set safe](\[0-9]+)$" $::names($oldName) X num]} {
  523.         verbose "matched, checking suffix"
  524.         if {$num >= $suffix} {
  525.             set suffix [expr $num+1]
  526.             verbose "new suffix: $suffix"
  527.         }
  528.         }
  529.     }
  530.     append name $suffix
  531.     verbose "new name: $name"
  532.     }
  533.  
  534.     ######################################################################
  535.     # start new xterm
  536.     ######################################################################
  537.     set xtermpid [eval exec xterm -name [list $name] -S$c1$c2$spawn_out(slave,fd) $::xtermArgs &]
  538.     verbose "xterm: pid = $xtermpid"
  539.     close -slave
  540.  
  541.     # xterm first sends back window id, save in environment so it can be
  542.     # passed on to the new process
  543.     log_user 0
  544.     expect {
  545.     eof {wait;return}
  546.     -re (.*)\n {
  547.         # convert hex to decimal
  548.         # note quotes must be used here to avoid diagnostic from expr
  549.         set ::env(WINDOWID) [expr "0x$expect_out(1,string)"]
  550.     }
  551.     }
  552.  
  553.     ######################################################################
  554.     # start new process
  555.     ######################################################################
  556.     set pid [eval spawn -noecho $cmd]
  557.     verbose "$cmd: pid = $pid, spawn_id = $spawn_id"
  558.     set sidCmd $spawn_id
  559.     lappend ::activeList $sidCmd
  560.     set ::activeArray($sidCmd) 1
  561.  
  562.     ######################################################################
  563.     # link everything back to spawn id of new process
  564.     ######################################################################
  565.     set ::xtermSid($sidCmd) $sidXterm
  566.     set ::names($sidCmd)    $name
  567.     set ::xtermPid($sidCmd) $xtermpid
  568.  
  569.     ######################################################################
  570.     # connect proc output to xterm output
  571.     # connect xterm input to proc input
  572.     ######################################################################
  573.     expect_background {
  574.     -i $sidCmd
  575.     -re ".+" [list sendTo $sidXterm]
  576.     eof [list xtermKill $sidCmd]
  577.     -i $sidXterm
  578.     -re ".+" [list sendTo $sidCmd]
  579.     eof [list xtermKill $sidCmd]
  580.     }
  581.  
  582.     .m.e entryconfig Active -state normal
  583.     .m.e.active add checkbutton -label $name -variable activeArray($sidCmd) \
  584.     -command [list xtermActiveUpdate $sidCmd]
  585.     set ::activeArray($sidCmd) 1
  586. }
  587.  
  588. proc xtermActiveUpdate {sid} {
  589.     if {$::activeArray($sid)} {
  590.     verbose "activating $sid"
  591.     } else {
  592.     verbose "deactivating $sid"
  593.     }
  594.     activeListUpdate
  595. }
  596.  
  597. proc activeListUpdate {} {
  598.     set ::activeList {}
  599.     foreach n [array names ::activeArray] {
  600.     if {$::activeArray($n)} {
  601.         lappend ::activeList $n
  602.     }
  603.     }
  604. }
  605.  
  606. # make a string safe to go through regexp
  607. proc safe {s} {
  608.     string map {{[} {\[} {*} {\*} {+} {\+} {^} {\^} {$} {\\$}} $s
  609. }
  610.  
  611. # utility to map xterm name to spawn id
  612. # multixterm doesn't use this but a user might want to
  613. proc xtermGet {name} {
  614.     foreach sid [array names ::names] {
  615.     if {[string equal $name $::names($sid)]} {
  616.         return $sid
  617.     }
  618.     }
  619.     error "no such term with name: $name"
  620. }
  621.  
  622. # utility to activate an xterm
  623. # multixterm doesn't use this but a user might want to
  624. proc xtermActivate {sid} {
  625.     set ::activeArray($sid) 1
  626.     xtermActiveUpdate $sid
  627. }
  628.  
  629. # utility to deactivate an xterm
  630. # multixterm doesn't use this but a user might want to
  631. proc xtermDeactivate {sid} {
  632.     set ::activeArray($sid) 0
  633.     xtermActiveUpdate $sid
  634. }
  635.  
  636. # utility to do an explicit Expect
  637. # multixterm doesn't use this but a user might want to
  638. proc xtermExpect {args} {
  639.     # check if explicit spawn_id in args
  640.     for {set i 0} {$i < [llength $args]} {incr i} {
  641.     switch -- [lindex $args $i] "-i" {
  642.         set sidCmd [lindex $args [incr i]]
  643.         break
  644.     }
  645.     }
  646.  
  647.     if {![info exists sidCmd]} {
  648.     # nothing explicit, so get it from the environment
  649.  
  650.     upvar spawn_id spawn_id
  651.  
  652.     # mimic expect's normal behavior in obtaining spawn_id
  653.     if {[info exists spawn_id]} {
  654.         set sidCmd $spawn_id
  655.     } else {
  656.         set sidCmd $::spawn_id
  657.     }
  658.     }
  659.  
  660.     # turn off bg expect, do fg expect, then re-enable bg expect
  661.  
  662.     expect_background -i $sidCmd    ;# disable bg expect
  663.     eval expect $args            ;# fg expect
  664.                     ;# reenable bg expect
  665.     expect_background {
  666.     -i $sidCmd
  667.     -re ".+" [list sendTo $::xtermSid($sidCmd)]
  668.     eof [list xtermKill $sidCmd]
  669.     }
  670. }
  671.  
  672. ######################################################################
  673. # connect main window keystrokes to all xterms
  674. ######################################################################
  675. proc xtermSend {A} {
  676.     if {[info exists ::afterId]} {
  677.     after cancel $::afterId
  678.     }
  679.     .input config -bg $::colorTyping
  680.     set ::afterId [after 1000 {.input config -bg $colorCurrent}]
  681.  
  682.     exp_send -raw -i $::activeList -- $A
  683. }
  684.  
  685. proc sendTo {to} {
  686.     exp_send -raw -i $to -- $::expect_out(buffer)
  687. }
  688.  
  689. # catch the case where there's no selection
  690. proc xtermPaste {} {catch {xtermSend [selection get]}}
  691.  
  692. ######################################################################
  693. # clean up an individual process death or xterm death
  694. ######################################################################
  695. proc xtermKill {s} {
  696.     verbose "killing xterm $s"
  697.  
  698.     if {![info exists ::xtermPid($s)]} {
  699.     verbose "too late, already dead"
  700.     return
  701.     }
  702.  
  703.     catch {exec /bin/kill -9 $::xtermPid($s)}
  704.     unset ::xtermPid($s)
  705.  
  706.     # remove sid from activeList
  707.     verbose "removing $s from active array"
  708.     catch {unset ::activeArray($s)}
  709.     activeListUpdate
  710.  
  711.     verbose "removing from background handler $s"
  712.     catch {expect_background -i $s}
  713.     verbose "removing from background handler $::xtermSid($s)"
  714.     catch {expect_background -i $::xtermSid($s)}
  715.     verbose "closing proc"
  716.     catch {close -i $s}
  717.     verbose "closing xterm"
  718.     catch {close -i $::xtermSid($s)}
  719.     verbose "waiting on proc"
  720.     wait -i $s
  721.     wait -i $::xtermSid($s)
  722.     verbose "done waiting"
  723.     unset ::xtermSid($s)
  724.  
  725.     # remove from active menu
  726.     verbose "deleting active menu entry $::names($s)"
  727.  
  728.     # figure out which it is
  729.     # avoid using name as an index since we haven't gone to any pains to
  730.     # make it safely interpreted by index-pattern code.  instead step
  731.     # through, doing the comparison ourselves
  732.     set last [.m.e.active index last]
  733.     # skip over tearoff
  734.     for {set i 1} {$i <= $last} {incr i} {
  735.     if {![catch {.m.e.active entrycget $i -label} label]} {
  736.         if {[string equal $label $::names($s)]} break
  737.     }
  738.     }
  739.     .m.e.active delete $i
  740.     unset ::names($s)
  741.  
  742.     # if none left, disable menu
  743.     # this leaves tearoff clone but that seems reasonable
  744.     if {0 == [llength [array names ::xtermSid]]} {
  745.     .m.e entryconfig Active -state disable
  746.     }
  747. }
  748.  
  749. ######################################################################
  750. # create windows
  751. ######################################################################
  752. tk_setPalette $palette
  753.  
  754. menu .m -tearoff 0
  755. .m add cascade -menu .m.f    -label "File" -underline 0
  756. .m add cascade -menu .m.e    -label "Edit" -underline 0
  757. .m add cascade -menu .m.help -label "Help" -underline 0
  758. set files [glob -nocomplain $cmdDir/*]
  759. set filesLength [llength $files]
  760. if {$filesLength >= $tearoffMenuMin} {
  761.     set filesTearoff 1
  762. } else {
  763.     set filesTearoff 0
  764. }
  765. menu .m.f    -tearoff $filesTearoff -title "multixterm files"
  766. menu .m.e    -tearoff 0
  767. menu .m.help -tearoff 0
  768. .m.f    add command -label Open -command openFile -underline 0
  769.  
  770. if {$filesLength} {
  771.     .m.f add separator
  772.     set files [lsort $files]
  773.     set files [lrange $files 0 $fileMenuMax]
  774.     foreach f $files {
  775.     .m.f add command -label $f -command [list openFile $f]
  776.     }
  777.     .m.f add separator
  778. }
  779.  
  780. .m.f    add command -label "Exit"     -command exit       -underline 0
  781. .m.e    add command -label "Paste"    -command xtermPaste -underline 0
  782. .m.e    add cascade -label "Active"   -menu .m.e.active   -underline 0
  783. .m.help add command -label "About"    -command about      -underline 0
  784. .m.help add command -label "Man Page" -command help       -underline 0
  785. . config -m .m
  786.  
  787. menu .m.e.active -tearoff 1 -title "multixterm active"
  788. .m.e entryconfig Active -state disabled
  789. # disable the Active menu simply because it looks goofy seeing an empty menu
  790. # for consistency, though, it should be enabled
  791.  
  792. entry  .input -textvar inputLabel -justify center -state disabled
  793. entry  .cmd   -textvar xtermCmd
  794. button .exec  -text "new xterm" -command {xtermStart $xtermCmd $xtermCmd}
  795.  
  796. grid .input -sticky ewns
  797. grid .cmd   -sticky ew
  798. grid .exec  -sticky ew -ipadx 3 -ipady 3
  799.  
  800. grid columnconfigure . 0 -weight 1
  801. grid    rowconfigure . 0 -weight 1  ;# let input window only expand
  802.  
  803. bind .cmd   <Return>        {xtermStart $xtermCmd $xtermCmd}
  804.  
  805. # send all keypresses to xterm 
  806. bind .input <KeyPress>         {xtermSend %A ; break}
  807. bind .input <Alt-KeyPress>     {xtermSend \033%A; break}
  808. bind .input <Meta-KeyPress>    {xtermSend \033%A; break}
  809. bind .input <<Paste>>          {xtermPaste ; break}
  810. bind .input <<PasteSelection>> {xtermPaste ; break}
  811.  
  812. # arrow keys - note that if they've been rebound through .Xdefaults
  813. # you'll have to change these definitions.
  814. bind .input <Up>    {xtermSend \033OA; break}
  815. bind .input <Down>  {xtermSend \033OB; break}
  816. bind .input <Right> {xtermSend \033OC; break}
  817. bind .input <Left>  {xtermSend \033OD; break}
  818. # Strange: od -c reports these as \033[A et al but when keypad mode
  819. # is initialized, they send \033OA et al.  Presuming most people
  820. # want keypad mode, I'll go with the O versions.  Perhaps the other
  821. # version is just a Sun-ism anyway.
  822.  
  823. set colorCurrent [.input cget -bg]
  824. set colorFocusOut $colorCurrent
  825.  
  826. # change color to show focus
  827. bind .input <FocusOut> colorFocusOut
  828. bind .input <FocusIn>  colorFocusIn
  829. proc colorFocusIn  {} {.input config -bg [set ::colorCurrent $::colorFocusIn]}
  830. proc colorFocusOut {} {.input config -bg [set ::colorCurrent $::colorFocusOut]}
  831.  
  832. # convert normal mouse events to focusIn
  833. bind .input <1>       {focus .input; break}
  834. bind .input <Shift-1> {focus .input; break}
  835.  
  836. # ignore all other mouse events that might make selection visible
  837. bind .input <Double-1>  break
  838. bind .input <Triple-1>  break
  839. bind .input <B1-Motion> break
  840. bind .input <B2-Motion> break
  841.  
  842. set scriptName [info script] ;# must get while it's active
  843.  
  844. proc about {} {
  845.     set w .about
  846.     if {[winfo exists $w]} {
  847.     wm deiconify $w
  848.     raise $w
  849.     return
  850.     }
  851.     toplevel     $w
  852.     wm title     $w "about multixterm"
  853.     wm iconname  $w "about multixterm"
  854.     wm resizable $w 0 0
  855.  
  856.     button $w.b -text Dismiss -command [list wm withdraw $w]
  857.  
  858.     label $w.title -text "multixterm" -font "Times 16" -borderwidth 10 -fg red
  859.     label $w.version -text "Version $::versionString, Released $::versionDate"
  860.     label $w.author -text "Written by Don Libes <don@libes.com>"
  861.     label $w.using -text "Using Expect [exp_version],\
  862.                                 Tcl $::tcl_patchLevel,\
  863.                                 Tk $::tk_patchLevel"
  864.     grid $w.title
  865.     grid $w.version
  866.     grid $w.author
  867.     grid $w.using
  868.     grid $w.b -sticky ew
  869. }
  870.  
  871. proc help {} {
  872.     if {[winfo exists .help]} {
  873.     wm deiconify .help
  874.     raise .help
  875.     return
  876.     }
  877.     toplevel    .help
  878.     wm title    .help "multixterm help"
  879.     wm iconname .help "multixterm help"
  880.  
  881.     scrollbar .help.sb -command {.help.text yview}
  882.     text .help.text -width 74 -height 30 -yscroll {.help.sb set} -wrap word
  883.  
  884.     button .help.ok -text Dismiss -command {destroy .help} -relief raised
  885.     bind .help <Return> {destroy .help;break}
  886.     grid .help.sb   -row 0 -column 0     -sticky ns
  887.     grid .help.text -row 0 -column 1     -sticky nsew
  888.     grid .help.ok   -row 1 -columnspan 2 -sticky ew -ipadx 3 -ipady 3
  889.  
  890.     # let text box only expand
  891.     grid rowconfigure    .help 0 -weight 1
  892.     grid columnconfigure .help 1 -weight 1
  893.  
  894.     set script [auto_execok $::scriptName]
  895.     if {[llength $script] == 0} {
  896.     set script /depot/tcl/bin/multixterm     ;# fallback
  897.     }
  898.     if {[catch {open $script} fid]} {
  899.     .help.text insert end "Could not open help file: $script"
  900.     } else {
  901.     # skip to the beginning of the actual help (starts with "NAME")
  902.     while {-1 != [gets $fid buf]} {
  903.         if {1 == [regexp "NAME" $buf]} {
  904.         .help.text insert end "\n NAME\n"
  905.         break
  906.         }
  907.     }
  908.     
  909.     while {-1 != [gets $fid buf]} {
  910.         if {0 == [regexp "^#(.?)(.*)" $buf X key buf]} break
  911.         if {$key == "!"} {
  912.         set buf [subst -nocommands $buf]
  913.         set key " "
  914.         }
  915.         .help.text insert end $key$buf\n
  916.     }
  917.     }
  918.  
  919.     # support scrolling beyond Tk's built-in Next/Previous
  920.     foreach w {"" .sb .text .ok} {
  921.     set W .help$w
  922.     bind $W <space>     {scrollPage  1}  ;#more
  923.     bind $W <Delete>     {scrollPage -1}  ;#more
  924.     bind $W <BackSpace>     {scrollPage -1}  ;#more
  925.     bind $W <Control-v>    {scrollPage  1}  ;#emacs
  926.     bind $W <Meta-v>    {scrollPage -1}  ;#emacs
  927.     bind $W <Control-f>    {scrollPage  1}  ;#vi
  928.     bind $W <Control-b>    {scrollPage -1}  ;#vi
  929.     bind $W <F35>        {scrollPage  1}  ;#sun
  930.     bind $W <F29>        {scrollPage -1}  ;#sun
  931.     bind $W <Down>            {scrollLine  1}
  932.     bind $W <Up>        {scrollLine -1}
  933.     }
  934. }
  935.  
  936. proc scrollPage {dir} {
  937.     tkScrollByPages .help.sb v $dir
  938.     return -code break
  939. }
  940.  
  941. proc scrollLine {dir} {
  942.     tkScrollByUnits .help.sb v $dir
  943.     return -code break
  944. }
  945.  
  946. ######################################################################
  947. # exit handling
  948. ######################################################################
  949.  
  950. # xtermKillAll is not intended to be user-callable.  It just kills
  951. # the processes and that's it. A user-callable version would update
  952. # the data structures, close the channels, etc.
  953.  
  954. proc xtermKillAll {} {
  955.     foreach sid [array names ::xtermPid] {
  956.     exec /bin/kill -9 $::xtermPid($sid)
  957.     }
  958. }
  959.  
  960. rename exit _exit
  961. proc exit {{x 0}} {xtermKillAll;_exit $x}
  962.  
  963. wm protocol . WM_DELETE_WINDOW exit
  964. trap exit SIGINT
  965.  
  966. ######################################################################
  967. # start any xterms requested
  968. ######################################################################
  969. proc xtermStartAll {} {
  970.     verbose "xtermNames = \"$::xtermNames\""
  971.     foreach n $::xtermNames {
  972.     regsub -all "%n" $::xtermCmd $n cmdOut
  973.     xtermStart $cmdOut $n
  974.     }
  975.     set ::xtermNames {}
  976. }
  977.  
  978. initLate
  979.  
  980. # now that xtermStartAll and its accompanying support has been set up
  981. # run it to start anything defined by rc file or command-line args.
  982.  
  983. xtermStartAll     ;# If nothing has been requested, this is a no-op.
  984.  
  985. # finally do any explicit command file
  986. if {[info exists cmdFile]} {
  987.     openFile $cmdFile
  988. }
  989.  
  990. puts hello
  991.